home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
yerk 3.66
/
Supplement
/
Demo Folder
/
Turtle
< prev
Wrap
Text File
|
1994-06-24
|
4KB
|
133 lines
( Turtle Graphics Objects for Demo )
( 05/05/84 CBD Version 1.0 )
Decimal
\ Define a turtle-graphics pen
:CLASS Pen <Super Object
\ 1st 5 Ivars comprise a PenState structure
Point PnLoc \ location of pen
Point PnSize \ width, height
Int PnMode
Var PnPatLo
Var PnPatHi
Angle Direction
Point homeLoc
Int maxReps
Int initLen
Int deltaLen \ change in len
Int deltaDeg \ change in angle
:M GET: (ABS) call GetPenState ;M \ save state here
:M SET: (ABS) call SetPenState ;M \ restore from here
:M TURN: +: Direction Get: Direction 359 >
IF -360 +: Direction THEN ;M
:M NORTH: 0 Put: Direction ;M
\ ( x y -- ) Draw a line to x,y if pen shows
:M MOVETO: Set: Self Pack call LineTo Get: Self ;M
\ ( d -- ) Draw d bits in current direction
:M MOVE: { Dist -- }
set: self Sin: Direction dist * 10000 /
Cos: Direction dist * 10000 /
Pack call Line get: self ;M
\ ( x y -- ) Goto a location without drawing
:M GOTO: Put: PnLoc ;M
\ ( x y -- ) set the center coordinates
:M CENTER: put: homeLoc ;M
\ ( -- ) Place Pen in center of Forth Window
:M HOME: get: homeLoc Goto: Self ;M
\ ( w h -- ) Set size in pixels of drawing pen
:M SIZE: Put: PnSize ;M
\ ( x y w h mode -- )
:M INIT: Put: PnMode Put: PnSize Put: PnLoc ;M
\ ( initlen dLen dDeg -- ) set parameters
:M PUTRANGE: put: deltaDeg put: deltaLen put: initLen ;M
\ ( maxReps -- )
:M PUTMAX: put: maxReps ;M
:M CLASSINIT: Get: self home: self 200 put: maxReps ;M
\ Draw a spiral of line segments - Logo POLYSPI
:M SPIRAL: { \ dist degrees delta -- } home: self
get: initLen -> dist get: deltaLen -> delta
get: deltaDeg -> degrees
BEGIN dist get: maxReps <
WHILE
dist Move: Self degrees Turn: Self
delta ++> dist
REPEAT ;M
\ ( n -- ) Dragon curves from Martin Gardner
:M DRAGON: Dup 0=
IF Get: deltaLen Move: Self Drop
ELSE Dup 0 >
IF Dup 1- Dragon: Self
Get: DeltaDeg Turn: Self
1 swap - Dragon: Self
ELSE -1 over - Dragon: Self
360 Get: deltaDeg - turn: Self
1+ Dragon: Self
THEN
THEN ;M
\ draw an infinite Lissajous figure
:M LJ: { \ c1 c2 chg reps -- } North: self 0 -> reps
get: initLen -> c1 get: deltaLen -> c2 get: deltaDeg -> chg
0 sin 120 / getX: homeLoc + 0 cos 120 / getY: homeLoc + goto: self
BEGIN 1 ++> reps reps get: maxReps <
WHILE
c1 Get: direction * sin 120 / getX: homeLoc +
c2 Get: direction * cos 120 / getY: homeLoc + MoveTo: Self
chg turn: self \ allow the user to stop it
REPEAT ;M
;CLASS
\ Define a Smalltalk Polygon object as subclass of Pen
:CLASS Poly <Super Pen
Int Sides \ # of sides in the Polygon
Int Length \ of each side
:M DRAW: Get: Sides 0
DO Get: Length Move: Self
360 Get: Sides / Turn: Self
LOOP ;M
\ ( len #sides -- ) Store sides and go to Home
:M SIZE: Get: Self Put: Sides Put: Length
Home: Self North: Self ;M
\ Spin a series of polygons around a point
:M SPIN: { \ reps -- } Home: self 10 Get: InitLen Size: self
0 -> reps
BEGIN reps get: maxReps <
WHILE Draw: Self Get: deltaDeg Turn: Self
Get: deltaLen +: Length 1 ++> reps
REPEAT ;M
\ Default Poly is 30-dot triangle
:M CLASSINIT: 30 3 Size: self 100 put: maxReps ;M
;CLASS
\ Create a pen named Bic
Pen Bic
\ Create a Polygon name Anna
Poly Anna
60 4 Size: Anna